home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok33.lha / FInOut / FInOut.mod < prev    next >
Text File  |  1993-08-15  |  14KB  |  539 lines
  1. (*****************************************************************
  2.    :Program.    FInOut.mod
  3.    :Contents.   InOut Schnittstelle für Dateien
  4.    :Author.     Michael Frieß
  5.    :Address.    Mühlhaldenweg 16
  6.    :Phone.      (0)7157 / 9614
  7.    :Shortcut.   [mif]
  8.    :Version.    1.0
  9.    :Date.       26.11.89
  10.    :Copyright.  PD
  11.    :Language.   Modula-2
  12.    :Translator. M2Amiga
  13. *****************************************************************)
  14.  
  15. (* $R- $V- $S- $F- *)
  16.  
  17. IMPLEMENTATION MODULE FInOut;
  18.  
  19. FROM SYSTEM IMPORT ADR, CAST;
  20. IMPORT Dos;
  21. FROM MemSystem IMPORT Allocate, Deallocate;
  22. FROM ASCII IMPORT eof, eol, vt, ht, sp, cr;
  23. FROM InOut   IMPORT WriteString, WriteLn;
  24. FROM Conversions IMPORT StrToVal, ValToStr;
  25. FROM Str IMPORT Length, FirstPos, noOccur;
  26.  
  27. CONST BUFFERSIZE = 1024; (* Größe des internen Textpuffers *)
  28.  
  29. TYPE sizeIndex = [0..BUFFERSIZE-1];
  30.  
  31. TYPE file = POINTER TO RECORD
  32.               fp    : Dos.FileHandlePtr;
  33.               Error : error;
  34.               IOErr : LONGINT;
  35.               Buf   : [0..1];
  36.               Off   : sizeIndex;
  37.               Valid : BOOLEAN;
  38.               Buffer: ARRAY [0..1], sizeIndex OF CHAR;
  39.             END;
  40.  
  41. (*****************************************************************)
  42. PROCEDURE FOpen (VAR f: file;
  43.                  FileName: ARRAY OF CHAR; Mode: CHAR) : error;
  44.  VAR i: LONGINT;
  45.  
  46.  BEGIN (* Open *)
  47.   (* examine parameters *)
  48.   CASE Mode OF
  49.     "r", "R": i := Dos.readOnly;
  50. (* not yet implemented:
  51.   | "w", "W": i := Dos.readWrite;
  52. *)
  53.   | "n", "N": i := Dos.newFile;
  54.   ELSE
  55.     f := NIL;
  56.     RETURN ERRxInvalidParameters;
  57.   END;
  58.  
  59.   (* get some memory *)
  60.   Allocate (f, SIZE(f^));
  61.   IF f = NIL THEN RETURN ERRxNotEnoughMemory END;
  62.  
  63.   (* get a DOS file *)
  64.   f^.fp := Dos.Open (ADR(FileName[0]), i);
  65.   IF f^.fp = NIL THEN
  66.     Deallocate( f);
  67.     RETURN ERRxIOError;
  68.   END;
  69.  
  70.   (* initialize buffer *)
  71.   WITH f^ DO
  72.     i := Dos.Read (fp, ADR(Buffer[0,0]), LONGINT(BUFFERSIZE-1));
  73.     Buf := 0;
  74.     Off := 0;
  75.     IF i < BUFFERSIZE THEN Buffer[0, i] := eof END;
  76.     Valid := TRUE;
  77.     Error := ERRxNone;
  78.   END;
  79.  
  80.   RETURN ERRxNone;
  81.  END FOpen;
  82.  
  83. (*****************************************************************)
  84. PROCEDURE FClose (VAR f: file): BOOLEAN;
  85.  VAR i : LONGINT;
  86.  BEGIN
  87.   WITH f^ DO
  88.     IF NOT Valid THEN
  89.       (* buffer must be saved *)
  90.       i := Dos.Write (fp, ADR(Buffer[Buf, 0]), Off+1);
  91.       IF i < LONGINT(Off+1) THEN
  92.         (* error while saving buffer *)
  93.         IOErr := Dos.IoErr();
  94.         Error := ERRxIOError;
  95.         RETURN FALSE;
  96.       END;
  97.     END;
  98.   END;
  99.   (* okay, close DOS file *)
  100.   Dos.Close (f^.fp);
  101.   Deallocate (f);
  102.   RETURN TRUE;
  103.  END FClose;
  104.  
  105. (*****************************************************************)
  106. PROCEDURE FError (f: file): error;
  107.  BEGIN
  108.    RETURN f^.Error;
  109.  END FError;
  110.  
  111. (*****************************************************************)
  112. PROCEDURE IOError (f: file): LONGINT;
  113.  BEGIN
  114.    (* if no io error occured ... *)
  115.    IF f^.Error # ERRxIOError THEN
  116.      RETURN 0;
  117.    END;
  118.    (* return saved IOError *)
  119.    RETURN f^.IOErr;
  120.  END IOError;
  121.  
  122. (*****************************************************************)
  123. PROCEDURE FSkip (f: file): LONGINT;
  124.  VAR ReadCt, i : LONGINT;
  125.  BEGIN (* FSkip *)
  126.   f^.Error := ERRxNone;
  127.    WITH f^ DO
  128.      i := - LONGINT(Off);
  129.      (* M2Amiga does not handle character sets *)
  130.      WHILE (Buffer[Buf, Off] = eol) OR
  131.            (Buffer[Buf, Off] = cr)  OR
  132.            (Buffer[Buf, Off] = sp)  OR
  133.            (Buffer[Buf, Off] = ht)  OR
  134.            (Buffer[Buf, Off] = vt)  DO
  135.        IF Off < BUFFERSIZE-1 THEN
  136.          (* not end of buffer *)
  137.          INC(Off);
  138.        ELSE
  139.          (* end of buffer reached *)
  140.          i := i + BUFFERSIZE;
  141.          (* switch buffer *)
  142.          Buf := 1-Buf;
  143.          Off := 0;
  144.          ReadCt := Dos.Read (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
  145.          IF ReadCt <= 0 THEN
  146.            Buffer[Buf, 0] := eof
  147.          ELSIF ReadCt < BUFFERSIZE THEN Buffer[Buf, ReadCt] := eof
  148.          END;
  149.        END;
  150.      END;
  151.      i := i + LONGINT(Off);
  152.    END;
  153.    RETURN i;
  154.  END FSkip;
  155.  
  156. (*****************************************************************)
  157. PROCEDURE FRead (f: file): CHAR;
  158.  VAR Ch: CHAR;
  159.       ReadCt: LONGINT;
  160.  BEGIN (* FRead *)
  161.   f^.Error := ERRxNone;
  162.   WITH f^ DO
  163.     Ch := Buffer[Buf, Off];
  164.     IF Ch # eof THEN
  165.       IF Off < BUFFERSIZE-1 THEN
  166.         INC (Off);
  167.       ELSE
  168.         Buf := 1-Buf;
  169.         Off := 0;
  170.         ReadCt := Dos.Read (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
  171.         IF ReadCt <= 0 THEN
  172.           Buffer[Buf, 0] := eof
  173.         ELSIF ReadCt < BUFFERSIZE THEN Buffer[Buf, ReadCt] := eof
  174.         END;
  175.       END;
  176.     END;
  177.   END;
  178.   RETURN Ch;
  179.  END FRead;
  180.  
  181. (*****************************************************************)
  182. PROCEDURE FReadString (f: file; VAR Str: ARRAY OF CHAR): LONGINT;
  183.  VAR ReadCt, i: LONGINT;
  184.  
  185.  BEGIN (* ReadString *)
  186.   f^.Error := ERRxNone;
  187.    i := 0;
  188.    WITH f^ DO
  189.      WHILE (Buffer[Buf, Off] # eof) AND
  190.            (i < HIGH (Str))         DO
  191.        Str[i] := Buffer[Buf, Off];
  192.        INC(i);
  193.        IF Off < BUFFERSIZE-1 THEN
  194.          INC(Off);
  195.        ELSE
  196.         Buf := 1-Buf;
  197.         Off := 0;
  198.         ReadCt := Dos.Read (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
  199.         IF ReadCt <= 0 THEN
  200.           Buffer[Buf, 0] := eof
  201.         ELSIF ReadCt < BUFFERSIZE THEN Buffer[Buf, ReadCt] := eof
  202.         END;
  203.        END;
  204.      END;
  205.    END;
  206.    IF i = HIGH (Str) THEN
  207.      RETURN -1;
  208.    ELSE
  209.      Str[i] := 00C;
  210.      RETURN i;
  211.    END;
  212.  END FReadString;
  213.  
  214. (*****************************************************************)
  215. PROCEDURE FReadWord (f: file; VAR Word: ARRAY OF CHAR): LONGINT;
  216.  VAR ReadCt, i: LONGINT;
  217.  
  218.  BEGIN (* ReadWord *)
  219.    ReadCt := FSkip (f);
  220.    i := 0;
  221.    WITH f^ DO
  222.      WHILE (Buffer[Buf, Off] # eof) AND
  223.            (Buffer[Buf, Off] # eol) AND
  224.            (Buffer[Buf, Off] # cr)  AND
  225.            (Buffer[Buf, Off] # sp)  AND
  226.            (Buffer[Buf, Off] # ht)  AND
  227.            (Buffer[Buf, Off] # vt)  AND
  228.            (i < HIGH (Word))         DO
  229.        Word[i] := Buffer[Buf, Off];
  230.        INC(i);
  231.        IF Off < BUFFERSIZE-1 THEN
  232.          INC(Off);
  233.        ELSE
  234.         Buf := 1-Buf;
  235.         Off := 0;
  236.         ReadCt := Dos.Read (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
  237.         IF ReadCt <= 0 THEN
  238.           Buffer[Buf, 0] := eof
  239.         ELSIF ReadCt < BUFFERSIZE THEN Buffer[Buf, ReadCt] := eof
  240.         END;
  241.        END;
  242.      END;
  243.    END;
  244.    IF i = HIGH (Word) THEN
  245.      RETURN -1;
  246.    ELSE
  247.      Word[i] := 00C;
  248.      RETURN i;
  249.    END;
  250.  END FReadWord;
  251.  
  252. (*****************************************************************)
  253. PROCEDURE FReadLine (f: file; VAR Line: ARRAY OF CHAR): LONGINT;
  254.  VAR ReadCt, i: LONGINT;
  255.  
  256.  BEGIN (* ReadLine *)
  257.   f^.Error := ERRxNone;
  258.    i := 0;
  259.    WITH f^ DO
  260.      WHILE (Buffer[Buf, Off] # eof) AND
  261.            (Buffer[Buf, Off] # eol) AND
  262.            (Buffer[Buf, Off] # cr)  AND
  263.            (i < HIGH (Line))         DO
  264.        Line[i] := Buffer[Buf, Off];
  265.        INC(i);
  266.        IF Off < BUFFERSIZE-1 THEN
  267.          INC(Off);
  268.        ELSE
  269.         Buf := 1-Buf;
  270.         Off := 0;
  271.         ReadCt := Dos.Read (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
  272.         IF ReadCt <= 0 THEN
  273.           Buffer[Buf, 0] := eof
  274.         ELSIF ReadCt < BUFFERSIZE THEN Buffer[Buf, ReadCt] := eof
  275.         END;
  276.        END;
  277.      END;
  278.    END;
  279.    IF i = HIGH (Line) THEN
  280.      RETURN -1;
  281.    ELSE
  282.      Line[i] := 00C;
  283.      RETURN i;
  284.    END;
  285.  END FReadLine;
  286.  
  287. (*****************************************************************)
  288. PROCEDURE FReadToken (f: file; VAR Token: ARRAY OF CHAR;
  289.                       Alphabet: ARRAY OF CHAR): LONGINT;
  290.  VAR ReadCt, i: LONGINT;
  291.      Ok : BOOLEAN;
  292.  
  293.  BEGIN (* ReadToken *)
  294.    ReadCt := FSkip (f);
  295.    i := 0;
  296.    Ok := TRUE;
  297.    WITH f^ DO
  298.      WHILE (Buffer[Buf, Off] # eof) AND
  299.            (Buffer[Buf, Off] # eol) AND
  300.            (Buffer[Buf, Off] # cr)  AND
  301.            (Buffer[Buf, Off] # sp)  AND
  302.            (Buffer[Buf, Off] # ht)  AND
  303.            (Buffer[Buf, Off] # vt)  AND
  304.            (i < HIGH (Token))       AND
  305.            Ok                       DO
  306.        IF (FirstPos( Alphabet, 0, Buffer[ Buf, Off]) = noOccur) THEN
  307.          Error := ERRxInvalidChar;
  308.          Ok    := FALSE;
  309.        ELSE
  310.          Token[i] := Buffer[Buf, Off];
  311.          INC(i);
  312.          IF Off < BUFFERSIZE-1 THEN
  313.            INC(Off);
  314.          ELSE
  315.           Buf := 1-Buf;
  316.           Off := 0;
  317.           ReadCt := Dos.Read (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
  318.           IF ReadCt <= 0 THEN
  319.             Buffer[Buf, 0] := eof
  320.           ELSIF ReadCt < BUFFERSIZE THEN Buffer[Buf, ReadCt] := eof
  321.           END;
  322.          END;
  323.        END;
  324.      END;
  325.    END;
  326.    IF i = HIGH (Token) THEN
  327.      RETURN -1;
  328.    ELSE
  329.      Token[i] := 00C;
  330.      RETURN i;
  331.    END;
  332.  END FReadToken;
  333.  
  334. (*****************************************************************)
  335. PROCEDURE FReadLongInt (f: file): LONGINT;
  336.  VAR Str : ARRAY [1..16] OF CHAR;
  337.      n   : LONGINT;
  338.      Signed, Err: BOOLEAN;
  339.      i, Len   : INTEGER;
  340.  BEGIN (* FReadLongInt *)
  341.   n   := FSkip( f);
  342.   Len := INTEGER(FReadWord (f, Str));
  343.   i := 1;
  344.   IF (Str[i] = "+") OR (Str[i] = "-") THEN INC(i) END;
  345.   WHILE i <= Len DO
  346.     IF (Str[i] >= "0") AND (Str[i] <= "9") THEN
  347.       INC(i);
  348.     ELSE
  349.       f^.Error := ERRxInvalidChar;
  350.       Str[i] := 00C;
  351.       Len := i-1;
  352.     END;
  353.   END;
  354.   StrToVal ( Str, n, Signed, 10, Err);
  355.   IF NOT Err AND ((n > 0) OR Signed) THEN
  356.     RETURN n
  357.   ELSE
  358.     f^.Error := ERRxConversionError;
  359.     RETURN 0
  360.   END;
  361.  END FReadLongInt;
  362.  
  363. (*****************************************************************)
  364. PROCEDURE FReadInt (f: file): INTEGER;
  365.  VAR i : LONGINT;
  366.  
  367.  BEGIN (* FReadInt *)
  368.   i := FReadLongInt (f);
  369.   IF (MIN(INTEGER) <= i) AND (i <= MAX(INTEGER)) THEN
  370.     RETURN INTEGER(i)
  371.   ELSE
  372.     f^.Error := ERRxRangeError;
  373.     RETURN 0
  374.   END;
  375.  END FReadInt;
  376.  
  377. (*****************************************************************)
  378. PROCEDURE FReadCard (f: file): CARDINAL;
  379.  VAR i : LONGINT;
  380.  BEGIN (* FReadCard *)
  381.   i := FReadLongInt( f);
  382.   IF (MIN(CARDINAL) <= i) AND (i <= MAX(CARDINAL)) THEN
  383.     RETURN CARDINAL(i)
  384.   ELSE
  385.     f^.Error := ERRxRangeError;
  386.     RETURN 0
  387.   END;
  388.  END FReadCard;
  389.  
  390. (*****************************************************************)
  391. PROCEDURE FReadLongCard (f: file): LONGCARD;
  392.  VAR Str : ARRAY [1..16] OF CHAR;
  393.      n   : LONGINT;
  394.      Signed, Err: BOOLEAN;
  395.      i, Len : INTEGER;
  396.  BEGIN (* FReadLongCard *)
  397.   f^.Error := ERRxNone;
  398.   n   := FSkip( f);
  399.   Len := INTEGER(FReadWord (f, Str));
  400.   i := 1;
  401.   IF (Str[i] = "+") OR (Str[i] = "-") THEN INC(i) END;
  402.   WHILE i <= Len DO
  403.     IF (Str[i] >= "0") AND (Str[i] <= "9") THEN
  404.       INC(i);
  405.     ELSE
  406.       f^.Error := ERRxInvalidChar;
  407.       Len := i-1;
  408.       Str[i] := 00C;
  409.     END;
  410.   END;
  411.   StrToVal ( Str, n, Signed, 10, Err);
  412.   IF NOT Err THEN
  413.     IF n < 0 THEN
  414.       IF Signed THEN
  415.         f^.Error := ERRxConversionError;
  416.         RETURN 0;
  417.       ELSE
  418.         RETURN CAST(LONGCARD, n);
  419.       END;
  420.     END;
  421.     RETURN LONGCARD(n);
  422.   ELSE
  423.     f^.Error := ERRxConversionError;
  424.     RETURN 0;
  425.   END;
  426.  END FReadLongCard;
  427.  
  428. (*****************************************************************)
  429. PROCEDURE FWrite (f: file; Ch: CHAR);
  430.  VAR i : LONGINT;
  431.  BEGIN
  432.   f^.Error := ERRxNone;
  433.   WITH f^ DO
  434.     Buffer[Buf, Off] := Ch;
  435.     IF Off < BUFFERSIZE-1 THEN
  436.       INC (Off);
  437.       Valid := FALSE;
  438.     ELSE
  439.       i := Dos.Write (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
  440.       IF i < BUFFERSIZE THEN
  441.         Error := ERRxIOError;
  442.         IOErr := Dos.IoErr();
  443.       END;
  444.       Buf := 1-Buf;
  445.       Off := 0;
  446.       Valid := TRUE;
  447.     END;
  448.   END;
  449.  END FWrite;
  450.  
  451. (*****************************************************************)
  452. PROCEDURE FWriteString (f: file; Str: ARRAY OF CHAR);
  453.  VAR i, Len: LONGINT;
  454.  
  455.  BEGIN (* WriteString *)
  456.   f^.Error := ERRxNone;
  457.    i := 0;
  458.    Len := Length( Str);
  459.    WITH f^ DO
  460.      WHILE i < Len DO
  461.        Buffer[Buf, Off] := Str[i];
  462.        INC( i);
  463.        IF Off < BUFFERSIZE-1 THEN
  464.          INC( Off);
  465.          Valid := FALSE;
  466.        ELSE
  467.          i := Dos.Write (fp, ADR(Buffer[Buf,0]), LONGINT(BUFFERSIZE));
  468.          IF i < BUFFERSIZE THEN
  469.            Error := ERRxIOError;
  470.            IOErr := Dos.IoErr();
  471.          END;
  472.          Buf := 1-Buf;
  473.          Off := 0;
  474.          Valid := TRUE;
  475.        END;
  476.      END;
  477.    END;
  478.  END FWriteString;
  479.  
  480. (*****************************************************************)
  481. PROCEDURE FWriteLongInt (f: file; n: LONGINT; Width: INTEGER);
  482.  VAR Str : ARRAY [1..16] OF CHAR;
  483.      Err : BOOLEAN;
  484.  BEGIN (* FWriteLongInt *)
  485.   f^.Error := ERRxNone;
  486.   ValToStr (n, (n < 0), Str, 10, Width, " ", Err);
  487. WriteString ("TEST: "); WriteString( Str); WriteLn;
  488.   IF Err THEN
  489.     f^.Error := ERRxConversionError;
  490.   ELSE
  491.     FWriteString( f, Str);
  492.   END;
  493.  END FWriteLongInt;
  494.  
  495. (*****************************************************************)
  496. PROCEDURE FWriteInt (f: file; n, Width: INTEGER);
  497.  BEGIN (* FWriteInt *)
  498.   FWriteLongInt( f, LONGINT( n), Width);
  499.  END FWriteInt;
  500.  
  501. (*****************************************************************)
  502. PROCEDURE FWriteCard (f: file; n: CARDINAL; Width: INTEGER);
  503.  BEGIN (* FWriteCard *)
  504.   FWriteLongInt( f, LONGINT( n), Width);
  505.  END FWriteCard;
  506.  
  507. (*****************************************************************)
  508. PROCEDURE FWriteLongCard (f: file; n: LONGCARD; Width: INTEGER);
  509.  VAR Str : ARRAY [1..16] OF CHAR;
  510.      Err : BOOLEAN;
  511.      i   : LONGINT;
  512.  BEGIN (* FWriteLongCard *)
  513.   f^.Error := ERRxNone;
  514.   ValToStr (LONGINT( n), FALSE, Str, 10, Width, " ", Err);
  515. WriteString ("TEST: "); WriteString( Str); WriteLn;
  516.   IF Err THEN
  517.     f^.Error := ERRxConversionError;
  518.   ELSE
  519.     FWriteString( f, Str);
  520.   END;
  521.  END FWriteLongCard;
  522.  
  523. (*****************************************************************)
  524. PROCEDURE FWriteLn(f: file);
  525.  BEGIN
  526.   f^.Error := ERRxNone;
  527.   FWrite( f, eol);
  528.  END FWriteLn;
  529.  
  530. (*****************************************************************)
  531. PROCEDURE Eof (f: file) : BOOLEAN;
  532.  BEGIN (* Eof *)
  533.   WITH f^ DO
  534.     RETURN Buffer[Buf, Off] = eof
  535.   END;
  536.  END Eof;
  537.  
  538. END FInOut.
  539.